Visual Basic Script Active Directory Leer email de usuarios de una OU

DoCmd.SetWarnings False

Dim stDocName As String

stDocName = "LUSUARIOSEMAIL"

DoCmd.OpenQuery stDocName, acNormal, acEdit

Dim MIBD As Database

Dim miRS1 As Recordset

Set MIBD = DBEngine.Workspaces(0).Databases(0)

Set miRS1 = MIBD.OpenRecordset("USUARIOSEMAIL", DB_OPEN_TABLE)

Dim strDomainDN, strBase, strFilter, strAttrs, strScope

Dim objDIC

Dim objCmd, objConn, objRS

Dim iCount

strDomainDN = Me.pati

strBase = "<GC://" & strDomainDN & ">;"

strFilter = "(mail=*);"

strAttrs = "name,adspath,mail,url,department,company,userPrincipalName,streetAddress;"

strScope = "subtree"

Set objDIC = CreateObject("Scripting.Dictionary")

Set objConn = CreateObject("ADODB.Connection")

objConn.Provider = "ADsDSOObject"

objConn.Open "Active Directory Provider"

Set objCmd = CreateObject("ADODB.Command")

objCmd.ActiveConnection = objConn

objCmd.CommandText = strBase & strFilter & strAttrs & strScope

objCmd.Properties("Page Size") = 1000

Set objRS = objCmd.Execute

objRS.MoveFirst

While Not objRS.EOF

miRS1.AddNew

miRS1![Nombre completo] = objRS.Fields(0).Value

miRS1![email] = objRS.Fields(2).Value

miRS1![Path] = objRS.Fields(1)

miRS1![departamento] = objRS.Fields(4)

miRS1![company] = objRS.Fields(5)

miRS1![usuario] = Left(objRS.Fields(6), 8)

miRS1![direccion] = objRS.Fields(7)

miRS1.UpdateobjRS.MoveNextWend